library(tidyverse) # for graphing and data cleaning
library(lubridate) # for date manipulation
library(ggthemes) # for even more plotting themes
#library(janitor) # for cleaning variable names
theme_set(theme_minimal()) # My favorite ggplot() theme :)
library(treemapify)
# Read in the data for the week
employed <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-02-23/employed.csv')
earn <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-02-23/earn.csv')
In this week, I am interested in comparing the median weekly income of men and women in the last decade from 2010 to 2020. I decide to use geom_treemap and gganimate to create animation of a treemap that display the proportion of average median weekly income for each year and each ages group.
earn_clean <- earn %>%
filter(sex !="Both Sexes", age %in% c("16 to 19 years", "20 to 24 years", "25 to 34 years", "35 to 44 years", "45 to 54 years","55 to 64 years", "65 years and over")) %>%
group_by(sex, age, year) %>%
summarise(avg_median_weekly_earn = ceiling(sum(median_weekly_earn)/4), label = paste( avg_median_weekly_earn ))
earn_clean
p <-
earn_clean %>%
ggplot(aes(
label = label,
area = avg_median_weekly_earn,
subgroup = sex,
fill = age
)) +
geom_treemap(layout = "fixed") +
geom_treemap_text(layout = "fixed", place = "centre", grow = TRUE ) +
geom_treemap_subgroup_text(layout = "fixed", place = "centre", color = "white") +
geom_treemap_subgroup_border(layout = "fixed", color="white")+
theme(legend.position = "bottom")+
transition_time(year) +
ease_aes('linear') +
labs(title = "Median Weekly Income Distrubution in Dollars", subtitle = "Year: {round(frame_time,0)}", caption = " by Vichearith Meas", fill="Age Groups")
#
animate(p, duration = 1, fps = 15)
anim_save("tidyTuesday5_treemap.gif")
knitr::include_graphics("tidyTuesday5_treemap.gif")

LS0tCnRpdGxlOiAnVGlkeSBUdWVzZGF5ICM1JwphdXRob3I6ICJWaWNoZWFyaXRoIG1lYXMiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIGRmX3ByaW50OiBwYWdlZAogICAgY29kZV9kb3dubG9hZDogdHJ1ZQogICAgdGhlbWU6IGNlcnVsZWFuCiAgICBjb2RlX2ZvbGRpbmc6IGhpZGUKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFLCAKICAgICAgICAgICAgICAgICAgICAgIGVycm9yPVRSVUUsIAogICAgICAgICAgICAgICAgICAgICAgbWVzc2FnZT1GQUxTRSwgCiAgICAgICAgICAgICAgICAgICAgICB3YXJuaW5nPUZBTFNFKQpgYGAKCgpgYGB7ciBsaWJyYXJpZXN9CmxpYnJhcnkodGlkeXZlcnNlKSAgICAgIyBmb3IgZ3JhcGhpbmcgYW5kIGRhdGEgY2xlYW5pbmcKbGlicmFyeShsdWJyaWRhdGUpICAgICAjIGZvciBkYXRlIG1hbmlwdWxhdGlvbgpsaWJyYXJ5KGdndGhlbWVzKSAgICAgICMgZm9yIGV2ZW4gbW9yZSBwbG90dGluZyB0aGVtZXMKI2xpYnJhcnkoamFuaXRvcikgICAgICAgIyBmb3IgY2xlYW5pbmcgdmFyaWFibGUgbmFtZXMKdGhlbWVfc2V0KHRoZW1lX21pbmltYWwoKSkgIyBNeSBmYXZvcml0ZSBnZ3Bsb3QoKSB0aGVtZSA6KQpsaWJyYXJ5KHRyZWVtYXBpZnkpCmBgYAoKYGBge3J9CiMgUmVhZCBpbiB0aGUgZGF0YSBmb3IgdGhlIHdlZWsKZW1wbG95ZWQgPC0gcmVhZHI6OnJlYWRfY3N2KCdodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vcmZvcmRhdGFzY2llbmNlL3RpZHl0dWVzZGF5L21hc3Rlci9kYXRhLzIwMjEvMjAyMS0wMi0yMy9lbXBsb3llZC5jc3YnKQoKZWFybiA8LSByZWFkcjo6cmVhZF9jc3YoJ2h0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9yZm9yZGF0YXNjaWVuY2UvdGlkeXR1ZXNkYXkvbWFzdGVyL2RhdGEvMjAyMS8yMDIxLTAyLTIzL2Vhcm4uY3N2JykKCgpgYGAKSW4gdGhpcyB3ZWVrLCBJIGFtIGludGVyZXN0ZWQgaW4gY29tcGFyaW5nIHRoZSBfX21lZGlhbiB3ZWVrbHkgaW5jb21lX18gb2YgbWVuIGFuZCB3b21lbiBpbiB0aGUgbGFzdCBkZWNhZGUgZnJvbSAyMDEwIHRvIDIwMjAuIEkgZGVjaWRlIHRvIHVzZSBgZ2VvbV90cmVlbWFwYCBhbmQgYGdnYW5pbWF0ZWAgdG8gY3JlYXRlIGFuaW1hdGlvbiBvZiBhIHRyZWVtYXAgdGhhdCBkaXNwbGF5IHRoZSBwcm9wb3J0aW9uIG9mIGF2ZXJhZ2UgbWVkaWFuIHdlZWtseSBpbmNvbWUgZm9yIGVhY2ggeWVhciBhbmQgZWFjaCBhZ2VzIGdyb3VwLiAKYGBge3J9CmVhcm5fY2xlYW4gPC0gIGVhcm4gJT4lIAogIGZpbHRlcihzZXggIT0iQm90aCBTZXhlcyIsIGFnZSAlaW4lIGMoIjE2IHRvIDE5IHllYXJzIiwgIjIwIHRvIDI0IHllYXJzIiwgIjI1IHRvIDM0IHllYXJzIiwgIjM1IHRvIDQ0IHllYXJzIiwgIjQ1IHRvIDU0IHllYXJzIiwiNTUgdG8gNjQgeWVhcnMiLCAiNjUgeWVhcnMgYW5kIG92ZXIiKSkgJT4lIAogIGdyb3VwX2J5KHNleCwgYWdlLCB5ZWFyKSAlPiUgCiAgc3VtbWFyaXNlKGF2Z19tZWRpYW5fd2Vla2x5X2Vhcm4gPSBjZWlsaW5nKHN1bShtZWRpYW5fd2Vla2x5X2Vhcm4pLzQpLCBsYWJlbCA9IHBhc3RlKCBhdmdfbWVkaWFuX3dlZWtseV9lYXJuICkpCmVhcm5fY2xlYW4KYGBgCgoKYGBge3IgZXZhbD1GQUxTRX0KcCA8LQogIGVhcm5fY2xlYW4gJT4lIAogIGdncGxvdChhZXMoCiAgICBsYWJlbCA9IGxhYmVsLAogICAgYXJlYSA9IGF2Z19tZWRpYW5fd2Vla2x5X2Vhcm4sCiAgICBzdWJncm91cCA9IHNleCwKICAgIGZpbGwgPSBhZ2UKICApKSArCiAgZ2VvbV90cmVlbWFwKGxheW91dCA9ICJmaXhlZCIpICsKICBnZW9tX3RyZWVtYXBfdGV4dChsYXlvdXQgPSAiZml4ZWQiLCBwbGFjZSA9ICJjZW50cmUiLCBncm93ID0gVFJVRSApICsKICBnZW9tX3RyZWVtYXBfc3ViZ3JvdXBfdGV4dChsYXlvdXQgPSAiZml4ZWQiLCBwbGFjZSA9ICJjZW50cmUiLCBjb2xvciA9ICJ3aGl0ZSIpICsKICBnZW9tX3RyZWVtYXBfc3ViZ3JvdXBfYm9yZGVyKGxheW91dCA9ICJmaXhlZCIsIGNvbG9yPSJ3aGl0ZSIpKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJib3R0b20iKSsKICB0cmFuc2l0aW9uX3RpbWUoeWVhcikgKwogIGVhc2VfYWVzKCdsaW5lYXInKSArCiAgbGFicyh0aXRsZSA9ICJNZWRpYW4gV2Vla2x5IEluY29tZSBEaXN0cnVidXRpb24gaW4gRG9sbGFycyIsIHN1YnRpdGxlID0gIlllYXI6IHtyb3VuZChmcmFtZV90aW1lLDApfSIsIGNhcHRpb24gPSAiIGJ5IFZpY2hlYXJpdGggTWVhcyIsIGZpbGw9IkFnZSBHcm91cHMiKQojCmBgYAoKCmBgYHtyIGV2YWw9RkFMU0V9CmFuaW1hdGUocCwgZHVyYXRpb24gPSAxLCBmcHMgPSAxNSkKYGBgCgoKYGBge3IgZXZhbD1GQUxTRX0KYW5pbV9zYXZlKCJ0aWR5VHVlc2RheTVfdHJlZW1hcC5naWYiKQpgYGAKCmBgYHtyfQprbml0cjo6aW5jbHVkZV9ncmFwaGljcygidGlkeVR1ZXNkYXk1X3RyZWVtYXAuZ2lmIikKYGBgCgoK